Usenet 1993 July/InfoMagic USENET CD-ROM July 1993.ISO/sources/sun/volume1/tooltool2.1c/part05

Internet Message Format | 1989-06-06 | 44.4 KB

Path: uunet!husc6!rutgers!aramis.rutgers.edu!dartagnan.rutgers.edu!mcgrew
From: [e-mail] (Charles Mcgrew)
Newsgroups: comp.sources.sun
Subject: v01i024:  Tooltool - a suntools user interface builder, Part 05/13
Message-ID: <[e-mail]>
Date: 7 Jun 89 04:15:11 GMT
Organization: Rutgers Univ., New Brunswick, N.J.
Lines: 1528
Approved: [e-mail]

Submitted-by: Chuck Musciano <[e-mail]>
Posting-number: Volume 1, Issue 24
Archive-name: tooltool2.1c/part05

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#        "End of archive 5 (of 13)."
# Contents:  expr.c func.c lex.c
# Wrapped by chuck@melmac on Thu Jun  1 10:39:31 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'expr.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'expr.c'\"
else
echo shar: Extracting \"'expr.c'\" \(14434 characters\)
sed "s/^X//" >'expr.c' <<'END_OF_FILE'
X/************************************************************************/
X/*    Copyright 1988 by Chuck Musciano and Harris Corporation        */
X/*                                    */
X/*    Permission to use, copy, modify, and distribute this software    */
X/*    and its documentation for any purpose and without fee is    */
X/*    hereby granted, provided that the above copyright notice    */
X/*    appear in all copies and that both that copyright notice and    */
X/*    this permission notice appear in supporting documentation, and    */
X/*    that the name of Chuck Musciano and Harris Corporation not be    */
X/*    used in advertising or publicity pertaining to distribution    */
X/*    of the software without specific, written prior permission.    */
X/*    Chuck Musciano and Harris Corporation make no representations    */
X/*    about the suitability of this software for any purpose.  It is    */
X/*    provided "as is" without express or implied warranty.        */
X/*                                    */
X/*    The sale of any product based wholely or in part upon the     */
X/*    technology provided by tooltool is strictly forbidden without    */
X/*    specific, prior written permission from Harris Corporation.    */
X/*    Tooltool technology includes, but is not limited to, the source    */
X/*    code, executable binary files, specification language, and    */
X/*    sample specification files.                    */
X/************************************************************************/
X
X#include    <stdio.h>
X#include    <ctype.h>
X#include    <math.h>
X
X#include    "tooltool.h"
X
X/************************************************************************/
XPRIVATE    v_ptr    do_compare(op, l, r)
X
Xregister    int    op;
Xregister    v_ptr    l;
Xregister    v_ptr    r;
X
X{    register    char    *p, *q;
X
X    if (is_number(l) && is_number(r))
X       switch (op) {
X          case E_EQUAL         : return(tt_int_result(l->number == r->number));
X          case E_GREATER       : return(tt_int_result(l->number > r->number));
X          case E_GREATER_EQUAL : return(tt_int_result(l->number >= r->number));
X          case E_LESS          : return(tt_int_result(l->number < r->number));
X          case E_LESS_EQUAL    : return(tt_int_result(l->number <= r->number));
X          case E_NOT_EQUAL     : return(tt_int_result(l->number != r->number));
X          }
X    else {
X       p = tt_string_of(l);
X       q = tt_string_of(r);
X       switch (op) {
X          case E_EQUAL         : return(tt_int_result(strcmp(p, q) == 0));
X          case E_GREATER       : return(tt_int_result(strcmp(p, q) > 0));
X          case E_GREATER_EQUAL : return(tt_int_result(strcmp(p, q) >= 0));
X          case E_LESS          : return(tt_int_result(strcmp(p, q) < 0));
X          case E_LESS_EQUAL    : return(tt_int_result(strcmp(p, q) <= 0));
X          case E_NOT_EQUAL     : return(tt_int_result(strcmp(p, q) != 0));
X          }
X       }
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_array_ref(a, i)
X
Xregister    v_ptr    a;
Xregister    v_ptr    i;
X
X{    register    v_ptr    v;
X    register    char    *s;
X    register    int    cmp;
X
X    s = tt_string_of(i);
X    if (is_array(a)) {
X       for (v = a->value; v; )
X          if ((cmp = tt_dict_compare(s, v->index)) == 0)
X             break;
X          else if (cmp < 0)
X             v = v->left;
X          else
X             v = v->right;
X       if (v)
X          return(v);
X       }
X    else {
X       a->kind = V_ARRAY;
X       a->value = NULL;
X       }
X    v = (v_ptr) safe_malloc(sizeof(v_data));
X    v->kind = V_NOTHING;
X    v->number = 0.0;
X    v->str = "";
X    v->value = NULL;
X    v->left = NULL;
X    v->right = NULL;
X    tt_insert_array(&(a->value), strsave(s), v);
X    return(v);
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    dup_array(v)
X
Xregister    v_ptr    v;
X
X{    register    v_ptr    new;
X
X    if (v == NULL)
X       return(NULL);
X    new = (v_ptr) safe_malloc(sizeof(v_data));
X    new->kind = v->kind;
X    new->number = v->number;
X    new->left = dup_array(v->left);
X    new->right = dup_array(v->right);
X    new->index = strsave(v->index);
X    if (is_array(new))
X       new->value = dup_array(v->value);
X    else
X       new->str = is_number(new)? NULL : strsave(v->str);
X    return(new);
X}
X
X/************************************************************************/
XPRIVATE    char    *concatenate(v, separator)
X
Xregister    v_ptr    v;
Xchar        separator;
X
X{    register    char    *l, *m, *r, *p;
X    char    buf[2];
X
X    if (v == NULL)
X       return("");
X    buf[0] = separator;
X    buf[1] = '\0';
X    l = concatenate(v->left, separator);
X    m = tt_string_of(v);
X    r = concatenate(v->right, separator);
X    p = tt_emalloc(strlen(l) + strlen(m) + strlen(r) + 3);
X    strcpy(p, l);
X    if (*m) {
X       if (*p)
X          strcat(p, buf);
X       strcat(p, m);
X       }
X    if (*r) {
X       if (*p)
X          strcat(p, buf);
X       strcat(p, r);
X       }
X    return(p);
X}
X
X/************************************************************************/
XPRIVATE    free_array(v)
X
Xv_ptr    v;
X
X{
X    if (v) {
X       if (is_array(v))
X          safe_free(v->value);
X       safe_free(v->index);
X       free_array(v->left);
X       free_array(v->right);
X       safe_free(v);
X       }
X}
X
X/************************************************************************/
XPRIVATE    do_assign(l, r)
X
Xregister    v_ptr    l;
Xregister    v_ptr    r;
X
X{
X    if (is_array(l))
X       free_array(l->value);
X    l->kind = (r->kind & V_TYPES) | (l->kind & V_SPECIAL);
X    if (is_gadget(l))
X       switch (l->gadget->kind) {
X          case GADGET_CHOICE :
X          case GADGET_SLIDER : panel_set(l->gadget->panel_item, PANEL_VALUE, (int) r->number, 0);
X                         break;
X          case GADGET_TEXT   : panel_set(l->gadget->panel_item, PANEL_VALUE, tt_string_of(r), 0);
X                         break;
X/*          case GADGET_LABEL  : panel_set(l->gadget->panel_item, PANEL_LABEL_STRING, tt_string_of(r), 0);
X                         break;*/
X          default         : abend("cannot assign a value to a button or menu");
X          }
X    if (is_array(l))
X       l->value = dup_array(r->value);
X    else if (is_number(l))
X       l->number = r->number;
X    else {
X       l->str = strsave(r->str);
X       l->number = r->number;
X       }
X    if (is_interval(l))
X       tt_set_timer((int) l->number, ((int) (l->number * 1000000.0)) % 1000000);
X}
X
X/************************************************************************/
XEXPORT    v_ptr    tt_int_result(i)
X
Xint    i;
X
X{    char    buf[20];
X    register    v_ptr    v;
X
X    v = (v_ptr) tt_emalloc(sizeof(v_data));
X    v->str = NULL;
X    v->kind = V_NUMBER;
X    v->number = i;
X    v->left = NULL;
X    v->right = NULL;
X    return(v);
X}
X
X/************************************************************************/
XEXPORT    v_ptr    tt_double_result(r)
X
Xdouble    r;
X
X{    char    buf[20];
X    register    v_ptr    v;
X
X    v = (v_ptr) tt_emalloc(sizeof(v_data));
X    v->str = NULL;
X    v->kind = V_NUMBER;
X    v->number = r;
X    v->left = NULL;
X    v->right = NULL;
X    return(v);
X}
X
X/************************************************************************/
XEXPORT    v_ptr    tt_string_result(s)
X
Xchar    *s;
X
X{    char    buf[20];
X    double    atof();
X    register    v_ptr    v;
X
X    v = (v_ptr) tt_emalloc(sizeof(v_data));
X    if (tt_is_temp(s))
X       v->str = s;
X    else
X       v->str = estrsave(s);
X    v->kind = V_NOTHING;
X    v->number = tt_is_number(s)? atof(s) : 0.0;
X    v->left = NULL;
X    v->right = NULL;
X    return(v);
X}
X
X/************************************************************************/
XEXPORT    char    *tt_string_of(v)
X
Xregister    v_ptr    v;
X
X{    register    char    *p;
X    char    buf[20], *delimiters;
X
X    if (is_array(v)) {
X       if (is_array(tt_delimiters->value) || (delimiters = tt_string_of(tt_delimiters->value)) == NULL)
X          delimiters = " ";
X       return(concatenate(v->value, *delimiters));
X       }
X    else if (is_number(v)) {
X       sprintf(buf, "%1.12g", v->number);
X       return(estrsave(buf));
X       }
X    else
X       return(v->str);
X}
X
X/************************************************************************/
XEXPORT    v_ptr    tt_insert_array(array, index, value)
X
Xregister    v_ptr    *array;
Xregister    char    *index;
Xregister    v_ptr    value;
X
X{    int    cmp;
X
X    while (*array)
X       if ((cmp = tt_dict_compare(index, (*array)->index)) == 0)
X          abend("%s should not exist in array", index);
X       else if (cmp < 0)
X          array = &((*array)->left);
X       else
X          array = &((*array)->right);
X    *array = value;
X    value->index = index;
X}
X
X/************************************************************************/
XEXPORT    e_ptr    tt_make_expr(op, arg1, arg2, arg3)
X
Xint    op;
Xe_ptr    arg1, arg2, arg3;
X
X{    e_ptr    e;
X
X    e = (e_ptr) safe_malloc(sizeof(e_data));
X    switch (e->op = op) {
X       case E_QUESTION      :
X                     e->extra = arg3;
X       case E_AND           :
X       case E_ARRAY_REF     :
X       case E_ASSIGN_AND    :
X       case E_ASSIGN_DIVIDE :
X       case E_ASSIGN_MINUS  :
X       case E_ASSIGN_MODULO :
X       case E_ASSIGN_OR     :
X       case E_ASSIGN_PLUS   :
X       case E_ASSIGN_TIMES  :
X       case E_ASSIGN_XOR    :
X       case E_ASSIGNMENT    :
X       case E_COMMA         :
X       case E_DIVIDE        :
X       case E_EQUAL         :
X       case E_GREATER       :
X       case E_GREATER_EQUAL :
X       case E_LEFT_SHIFT    :
X       case E_LESS          :
X       case E_LESS_EQUAL    :
X       case E_LOGICAL_AND   :
X       case E_LOGICAL_NOT   :
X       case E_LOGICAL_OR    :
X       case E_MINUS         :
X       case E_MODULO        :
X       case E_NOT_EQUAL     :
X       case E_OR            :
X       case E_PLUS          :
X       case E_RIGHT_SHIFT   :
X       case E_TIMES         :
X       case E_XOR           :
X                     e->right = arg2;
X       case E_COMPLEMENT    :
X       case E_PAREN         :
X       case E_POSTDECREMENT :
X       case E_POSTINCREMENT :
X       case E_PREDECREMENT  :
X       case E_PREINCREMENT  :
X       case E_UMINUS        :
X                     e->left = arg1;
X                     break;
X       case E_FUNC_ID       : e->func = (f_ptr) arg1;
X                     e->left = arg2;
X                     break;
X       case E_STRING        : e->string = (char *) arg1;
X                     break;
X       case E_NUMBER    : e->value = *((double *) arg1);
X                     break;
X       case E_SYMBOL        : e->symbol = (s_ptr) arg1;
X                     break;
X       }
X    return(e);
X}
X
X/************************************************************************/
XEXPORT    v_ptr    tt_eval(e)
X
Xregister    e_ptr    e;
X
X{    double    r;
X    int    i;
X    v_ptr    v, w;
X    char    *p, *q, *s;
X
X    if (e == NULL)
X       return(NULL);
X    switch (e->op) {
X       case E_AND           : return(tt_int_result(((int) tt_eval(e->left)->number) & ((int) tt_eval(e->right)->number)));
X       case E_ARRAY_REF     : return(do_array_ref(tt_eval(e->left), tt_eval(e->right)));
X       case E_ASSIGN_AND    : v = tt_eval(e->left);
X                     do_assign(v, tt_int_result(((int) v->number) & ((int) tt_eval(e->right)->number)));
X                     return(v);
X       case E_ASSIGN_DIVIDE : v = tt_eval(e->left);
X                     if ((r = tt_eval(e->right)->number) == 0.0)
X                        abend("division by zero");
X                     else {
X                        do_assign(v, tt_double_result(v->number / r));
X                        return(v);
X                        }
X       case E_ASSIGN_MINUS  : v = tt_eval(e->left);
X                     do_assign(v, tt_double_result(v->number - tt_eval(e->right)->number));
X                     return(v);
X       case E_ASSIGN_MODULO : v = tt_eval(e->left);
X                     do_assign(v, tt_int_result(((int) v->number) % ((int) tt_eval(e->right)->number)));
X                     return(v);
X       case E_ASSIGN_OR     : v = tt_eval(e->left);
X                     do_assign(v, tt_int_result(((int) v->number) | ((int) tt_eval(e->right)->number)));
X                     return(v);
X       case E_ASSIGN_PLUS   : v = tt_eval(e->left);
X                     do_assign(v, tt_double_result(v->number + tt_eval(e->right)->number));
X                     return(v);
X       case E_ASSIGN_TIMES  : v = tt_eval(e->left);
X                     do_assign(v, tt_double_result(v->number * tt_eval(e->right)->number));
X                     return(v);
X       case E_ASSIGN_XOR    : v = tt_eval(e->left);
X                     do_assign(v, tt_int_result(((int) v->number) ^ ((int) tt_eval(e->right)->number)));
X                     return(v);
X       case E_ASSIGNMENT    : do_assign(tt_eval(e->left), v = tt_eval(e->right));
X                     return(v);
X       case E_COMMA         : p = tt_string_of(tt_eval(e->left));
X                     q = tt_string_of(tt_eval(e->right));
X                     s = tt_emalloc(strlen(p) + strlen(q) + 1);
X                     strcpy(s, p);
X                     strcat(s, q);
X                     return(tt_string_result(s));
X       case E_COMPLEMENT    : return(tt_int_result(~((int) tt_eval(e->left)->number)));
X       case E_DIVIDE        : if ((r = tt_eval(e->right)->number) == 0.0)
X                        abend("division by zero");
X                     else
X                        return(tt_double_result(tt_eval(e->left)->number / r));
X       case E_EQUAL         :
X       case E_GREATER       :
X       case E_GREATER_EQUAL :
X       case E_LESS          :
X       case E_LESS_EQUAL    :
X       case E_NOT_EQUAL     : return(do_compare(e->op, tt_eval(e->left), tt_eval(e->right)));
X       case E_FUNC_ID       : return(e->func(e->left));
X       case E_LEFT_SHIFT    : return(tt_int_result(((int) tt_eval(e->left)->number) << ((int) tt_eval(e->right)->number)));
X       case E_LOGICAL_AND   : return(tt_int_result(((int) tt_eval(e->left)->number) && ((int) tt_eval(e->right)->number)));
X       case E_LOGICAL_NOT   : return(tt_int_result(!((int) tt_eval(e->left)->number)));
X       case E_LOGICAL_OR    : return(tt_int_result(((int) tt_eval(e->left)->number) || ((int) tt_eval(e->right)->number)));
X       case E_MINUS         : return(tt_double_result(tt_eval(e->left)->number - tt_eval(e->right)->number));
X       case E_MODULO        : if ((i = ((int) tt_eval(e->right)->number)) == 0)
X                        abend("modulus by zero");
X                     else
X                        return(tt_int_result(((int) tt_eval(e->left)->number) % i));
X       case E_NUMBER    : return(tt_double_result(e->value));
X       case E_OR            : return(tt_int_result(((int) tt_eval(e->left)->number) | ((int) tt_eval(e->right)->number)));
X       case E_PAREN         : return(tt_eval(e->left));
X       case E_PLUS          : return(tt_double_result(tt_eval(e->left)->number + tt_eval(e->right)->number));
X       case E_POSTDECREMENT : v = tt_eval(e->left);
X                     do_assign(v, tt_double_result((r = v->number) - 1.0));
X                     return(tt_double_result(r));
X       case E_POSTINCREMENT : v = tt_eval(e->left);
X                     do_assign(v, tt_double_result((r = v->number) + 1.0));
X                     return(tt_double_result(r));
X       case E_PREDECREMENT  : v = tt_eval(e->left);
X                     do_assign(v, tt_double_result(v->number - 1.0));
X                     return(v);
X       case E_PREINCREMENT  : v = tt_eval(e->left);
X                     do_assign(v, tt_double_result(v->number + 1.0));
X                     return(v);
X       case E_QUESTION      : return(((int) tt_eval(e->left)->number)? tt_eval(e->right) : tt_eval(e->extra));
X       case E_RIGHT_SHIFT   : return(tt_int_result(((int) tt_eval(e->left)->number) >> ((int) tt_eval(e->right)->number)));
X       case E_STRING        : return(tt_string_result(e->string));
X       case E_SYMBOL        : return(tt_get_value(e->symbol));
X       case E_TIMES         : return(tt_double_result(tt_eval(e->left)->number * tt_eval(e->right)->number));
X       case E_UMINUS        : return(tt_double_result(-tt_eval(e->left)->number));
X       case E_XOR           : return(tt_int_result(((int) tt_eval(e->left)->number) ^ ((int) tt_eval(e->right)->number)));
X       }
X}
END_OF_FILE
if test 14434 -ne `wc -c <'expr.c'`; then
    echo shar: \"'expr.c'\" unpacked with wrong size!
fi
# end of 'expr.c'
fi
if test -f 'func.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'func.c'\"
else
echo shar: Extracting \"'func.c'\" \(13815 characters\)
sed "s/^X//" >'func.c' <<'END_OF_FILE'
X/************************************************************************/
X/*    Copyright 1988 by Chuck Musciano and Harris Corporation        */
X/*                                    */
X/*    Permission to use, copy, modify, and distribute this software    */
X/*    and its documentation for any purpose and without fee is    */
X/*    hereby granted, provided that the above copyright notice    */
X/*    appear in all copies and that both that copyright notice and    */
X/*    this permission notice appear in supporting documentation, and    */
X/*    that the name of Chuck Musciano and Harris Corporation not be    */
X/*    used in advertising or publicity pertaining to distribution    */
X/*    of the software without specific, written prior permission.    */
X/*    Chuck Musciano and Harris Corporation make no representations    */
X/*    about the suitability of this software for any purpose.  It is    */
X/*    provided "as is" without express or implied warranty.        */
X/*                                    */
X/*    The sale of any product based wholely or in part upon the     */
X/*    technology provided by tooltool is strictly forbidden without    */
X/*    specific, prior written permission from Harris Corporation.    */
X/*    Tooltool technology includes, but is not limited to, the source    */
X/*    code, executable binary files, specification language, and    */
X/*    sample specification files.                    */
X/************************************************************************/
X
X#include    <stdio.h>
X#include    <ctype.h>
X#include    <pwd.h>
X#include    <grp.h>
X
X#include    <sys/types.h>
X#include    <sys/stat.h>
X#include    <sys/file.h>
X
X#include    "tooltool.h"
X
XPUBLIC    char    *getenv(), *rindex();
X
XPRIVATE    v_ptr    do_cardinality(),
X        do_cd(),
X        do_executable(),
X        do_exists(),
X        do_format(),
X        do_getenv(),
X        do_group(),
X        do_head(),
X        do_index(),
X        do_is_open(),
X        do_length(),
X        do_output_of(),
X        do_pwd(),
X        do_readable(),
X        do_root(),
X        do_selection(),
X        do_stat(),
X        do_substr(),
X        do_suffix(),
X        do_system(),
X        do_tail(),
X        do_tokenize(),
X        do_user(),
X        do_verify(),
X        do_writable();
X
XPRIVATE    struct    {char    *name;
X         f_ptr    func;
X        } func[] = {{"cardinality", do_cardinality},
X                {"cd",          do_cd},
X                {"executable",  do_executable},
X                {"exists",      do_exists},
X                {"format",      do_format},
X                {"getenv",      do_getenv},
X                {"group",       do_group},
X                {"head",        do_head},
X                {"index",       do_index},
X                {"is_open",     do_is_open},
X                {"length",      do_length},
X                {"output_of",   do_output_of},
X                {"pwd",         do_pwd},
X                {"readable",    do_readable},
X                {"root",        do_root},
X                {"selection",   do_selection},
X                {"stat",        do_stat},
X                {"substr",      do_substr},
X                {"suffix",      do_suffix},
X                {"system",      do_system},
X                {"tail",        do_tail},
X                {"tokenize",    do_tokenize},
X                {"user",        do_user},
X                {"verify",      do_verify},
X                {"writable",    do_writable},
X                {NULL,          NULL}};
X
X/************************************************************************/
XEXPORT    f_ptr    tt_is_function(s)
X
Xchar    *s;
X
X{    int    i;
X
X    for (i = 0; func[i].name; i++)
X       if (strcmp(func[i].name, s) == 0)
X          return(func[i].func);
X    return(NULL);
X}
X
X/************************************************************************/
XPRIVATE    char    *fix_ctime(time)
X
Xint    *time;
X
X{    char    *p;
X
X    p = ctime(time);
X    p[24] = '\0';
X    return(p);
X}
X
X/************************************************************************/
XPRIVATE    e_ptr    get_parm(e, n)
X
Xe_ptr    e;
Xint    n;
X
X{    e_ptr    e1;
X    int    i, depth;
X
X    if (e == NULL)
X       return(NULL);
X    for (e1 = e, depth = 1; e1->op == E_COMMA; e1 = e1->left)
X       depth++;
X    if (n > depth)
X       return(NULL);
X    else if (depth == 1)
X       return(e);
X    else {
X       for (i = depth - n; i; i--)
X          e = e->left;
X       return((n == 1)? e : e->right);
X       }
X}
X
X/************************************************************************/
XPRIVATE    int    child_count(v)
X
Xv_ptr    v;
X
X{
X    return(v? child_count(v->left) + child_count(v->right) + 1 : 0);
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_cardinality(e)
X
Xe_ptr    e;
X
X{    v_ptr    v;
X
X    v = tt_eval(e);
X    if (is_array(v))
X       return(tt_int_result(child_count(v->value)));
X    else
X       return(tt_int_result(0));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_cd(e)
X
Xe_ptr    e;
X
X{
X    return(tt_int_result(chdir(tt_string_of(tt_eval(e)))? 0 : 1));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_executable(e)
X
Xe_ptr    e;
X
X{    struct    stat    buf;
X    int    result;
X    char    *p;
X
X    if (stat(p = tt_string_of(tt_eval(e)), &buf) == 0 && access(p, X_OK) == 0)
X       result = 1;
X    else
X       result = 0;
X    return(tt_int_result(result));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_exists(e)
X
Xe_ptr    e;
X
X{    struct    stat    buf;
X
X    return(tt_int_result((stat(tt_string_of(tt_eval(e)), &buf) == -1)? 0 : 1));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_format(e)
X
Xe_ptr    e;
X
X{    char    fmt[1024], result[1024], *p, *q, *r, *format;
X    int    parm;
X    e_ptr    e1;
X
X    format = tt_string_of(tt_eval(get_parm(e, 1)));
X    for (parm = 1, q = result, p = fmt; *format; format++) {
X       *p++ = *format;
X       if (*format == '%') {
X          for (format++; index("0123456789.-+ #", *format); )
X             *p++ = *format++;
X          *p++ = *format;
X          *p = '\0';
X          if (index("eEfgG", *format)) { /* print as a double */
X             if ((e1 = get_parm(e, ++parm)) == NULL)
X                abend("too few parameters supplied to 'format'");
X             sprintf(q, fmt, tt_eval(e1)->number);
X             }
X          else if (index("cdloxXu", *format)) { /* print as integer */
X             if ((e1 = get_parm(e, ++parm)) == NULL)
X                abend("too few parameters supplied to 'format'");
X             sprintf(q, fmt, (int) tt_eval(e1)->number);
X             }
X          else if (*format == 's') { /* a string */
X             if ((e1 = get_parm(e, ++parm)) == NULL)
X                abend("too few parameters supplied to 'format'");
X             sprintf(q, fmt, tt_string_of(tt_eval(e1)));
X             }
X          else if (*format == '%')
X             sprintf(q, fmt);
X          else
X             abend("invalid format character passed to 'format': %c", *format);
X          q += strlen(q);
X          p = fmt;
X          }
X       }
X    *p = '\0';
X    sprintf(q, fmt);
X    return(tt_string_result(result));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_getenv(e)
X
Xe_ptr    e;
X
X{    register    char    *p;
X
X    p = getenv(tt_string_of(tt_eval(e)));
X    return(tt_string_result(p? p : ""));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_group()
X
X{    register    struct    group    *gp;
X    register    int    gid;
X
X    if (gp = getgrgid(gid = getgid()))
X       return(tt_string_result(gp->gr_name));
X    else
X       return(tt_int_result(gid));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_head(e)
X
Xe_ptr    e;
X
X{    char    *p, *s;
X
X    p = tt_string_of(tt_eval(e));
X    if (s = rindex(p, '/'))
X       *s = '\0';
X    return(tt_string_result(p));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_index(e)
X
X{    char    *source, *target;
X    int    i;
X
X    source = tt_string_of(tt_eval(get_parm(e, 1)));
X    target = tt_string_of(tt_eval(get_parm(e, 2)));
X    if (source == NULL || target == NULL)
X       abend("too few parameters supplied to 'index'");
X    for (i = 1; *source; source++, i++) {
X       for ( ; *source && *source != *target; source++, i++)
X          ;
X       if (strncmp(source, target, strlen(target)) == 0)
X          return(tt_int_result(i));
X       }
X    return(tt_int_result(0));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_is_open()
X
X{
X    return(tt_int_result(window_get(tt_base_window->frame, FRAME_CLOSED)? 0 : 1));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_length(e)
X
Xe_ptr    e;
X
X{
X    return(tt_int_result(strlen(tt_string_of(tt_eval(e)))));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_output_of(e)
X
Xe_ptr    e;
X
X{    FILE    *f;
X    char    *buf, *p;
X    int    amt, size;
X
X    if ((f = popen(tt_string_of(tt_eval(e)), "r")) == NULL)
X       return(tt_int_result(-1));
X    for (buf = p = tt_emalloc(65536), size = 65536; size > 0 && (amt = fread(p, sizeof(char), 1024, f)); p += amt, size -= amt)
X       ;
X    *p = '\0';
X    pclose(f);
X    return(tt_string_result(buf));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_pwd()
X
X{    char    buf[1024];
X
X    getwd(buf);
X    return(tt_string_result(buf));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_readable(e)
X
Xe_ptr    e;
X
X{    struct    stat    buf;
X    int    result;
X    char    *p;
X
X    if (stat(p = tt_string_of(tt_eval(e)), &buf) == 0 && access(p, R_OK) == 0)
X       result = 1;
X    else
X       result = 0;
X    return(tt_int_result(result));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_root(e)
X
Xe_ptr    e;
X
X{    char    *s, *p, *q;
X
X    p = tt_string_of(tt_eval(e));
X    s = rindex(p, '/');
X    q = rindex(p, '.');
X    if (s) {
X       if (q > s)
X          *q = '\0';
X       }
X    else if (q)
X       *q = '\0';
X    return(tt_string_result(p));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_selection(e)
X
Xe_ptr    e;
X
X{
X    return(tt_string_result(tt_get_selection((int) tt_eval(e)->number)));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_stat(e)
X
Xe_ptr    e;
X
X{    register    v_ptr    v;
X    struct    stat    buf;
X    register    struct    passwd    *pp;
X    register    struct    group    *gp;
X
X    v = (v_ptr) tt_emalloc(sizeof(v_data));
X    v->kind = V_ARRAY;
X    v->index = NULL;
X    v->value = NULL;
X    v->left = NULL;
X    v->right = NULL;
X    if (stat(tt_string_of(tt_eval(e)), &buf) == 0) {
X       tt_insert_array(&(v->value), estrsave("mode"), tt_int_result(buf.st_mode));
X       if (pp = getpwuid(buf.st_uid))
X          tt_insert_array(&(v->value), estrsave("uid"), tt_string_result(pp->pw_name));
X       else
X          tt_insert_array(&(v->value), estrsave("uid"), tt_int_result(buf.st_uid));
X       if (gp = getgrgid(buf.st_gid))
X          tt_insert_array(&(v->value), estrsave("gid"), tt_string_result(gp->gr_name));
X       else
X          tt_insert_array(&(v->value), estrsave("gid"), tt_int_result(buf.st_gid));
X       tt_insert_array(&(v->value), estrsave("size"), tt_int_result(buf.st_size));
X       tt_insert_array(&(v->value), estrsave("atime"), tt_string_result(fix_ctime(&(buf.st_atime))));
X       tt_insert_array(&(v->value), estrsave("mtime"), tt_string_result(fix_ctime(&(buf.st_mtime))));
X       tt_insert_array(&(v->value), estrsave("ctime"), tt_string_result(fix_ctime(&(buf.st_ctime))));
X       }
X    return(v);
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_substr(e)
X
Xe_ptr    e;
X
X{    e_ptr    string, start, length;
X    char    *s;
X    int    st, l;
X
X    string = get_parm(e, 1);
X    start = get_parm(e, 2);
X    length = get_parm(e, 3);
X    if (get_parm(e, 4))
X       abend("too many arguments passed to 'substr'");
X    s = estrsave(tt_string_of(tt_eval(string)));
X    if ((st = start? tt_eval(start)->number - 1 : 0) < 0)
X       abend("negative starting position passed to 'substr': %d", st);
X    if ((l = length? tt_eval(length)->number : 0x7fffffff) < 0)
X       abend("negative length passed to 'substr': %d", l);
X    if (st > strlen(s))
X       *s = '\0';
X    else
X       s += st;
X    if (l <= strlen(s))
X       *(s + l) = '\0';
X    return(tt_string_result(s));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_suffix(e)
X
Xe_ptr    e;
X
X{    char    *s, *p, *q;
X
X    p = tt_string_of(tt_eval(e));
X    s = rindex(p, '/');
X    q = rindex(p, '.');
X    if (s)
X       p = (q > s)? q + 1 : "";
X    else
X       p = q? q + 1 : "";
X    return(tt_string_result(p));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_system(e)
X
Xe_ptr    e;
X
X{
X    return(tt_int_result(system(tt_string_of(tt_eval(e)))));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_tail(e)
X
Xe_ptr    e;
X
X{    char    *p, *s;
X
X    p = tt_string_of(tt_eval(e));
X    if (s = rindex(p, '/'))
X       p = s + 1;
X    return(tt_string_result(p));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_tokenize(e)
X
Xe_ptr    e;
X
X{    register    char    **tokens, *line;
X    register    int    i, max_count;
X    register    v_ptr    v;
X    char    buf[20];
X    int    count;
X
X    line = tt_string_of(tt_eval(e));
X    tokens = (char **) tt_emalloc((max_count = strlen(line) / 2 + 2) * sizeof(char *));
X    tokenize(line, &count, tokens, max_count);
X    v = (v_ptr) tt_emalloc(sizeof(v_data));
X    v->kind = V_ARRAY;
X    v->index = NULL;
X    v->value = NULL;
X    v->left = NULL;
X    v->right = NULL;
X    for (i = 0; i < count; i++) {
X       sprintf(buf, "%d", i);
X       tt_insert_array(&(v->value), estrsave(buf), tt_string_result(tokens[i]));
X       }
X    return(v);
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_user()
X
X{    register    struct    passwd    *pp;
X    register    int    uid;
X
X    if (pp = getpwuid(uid = getuid()))
X       return(tt_string_result(pp->pw_name));
X    else
X       return(tt_int_result(uid));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_verify(e)
X
X{    char    *source, *valid;
X
X    source = tt_string_of(tt_eval(get_parm(e, 1)));
X    valid = tt_string_of(tt_eval(get_parm(e, 2)));
X    if (source == NULL || valid == NULL)
X       abend("too few parameters supplied to 'verify'");
X    for ( ; *source; source++)
X       if (index(valid, *source) == NULL)
X          return(tt_int_result(0));
X    return(tt_int_result(1));
X}
X
X/************************************************************************/
XPRIVATE    v_ptr    do_writable(e)
X
Xe_ptr    e;
X
X{    struct    stat    buf;
X    int    result;
X    char    *p;
X
X    if (stat(p = tt_string_of(tt_eval(e)), &buf) == 0 && access(p, W_OK) == 0)
X       result = 1;
X    else
X       result = 0;
X    return(tt_int_result(result));
X}
END_OF_FILE
if test 13815 -ne `wc -c <'func.c'`; then
    echo shar: \"'func.c'\" unpacked with wrong size!
fi
# end of 'func.c'
fi
if test -f 'lex.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lex.c'\"
else
echo shar: Extracting \"'lex.c'\" \(13060 characters\)
sed "s/^X//" >'lex.c' <<'END_OF_FILE'
X/************************************************************************/
X/*    Copyright 1988 by Chuck Musciano and Harris Corporation        */
X/*                                    */
X/*    Permission to use, copy, modify, and distribute this software    */
X/*    and its documentation for any purpose and without fee is    */
X/*    hereby granted, provided that the above copyright notice    */
X/*    appear in all copies and that both that copyright notice and    */
X/*    this permission notice appear in supporting documentation, and    */
X/*    that the name of Chuck Musciano and Harris Corporation not be    */
X/*    used in advertising or publicity pertaining to distribution    */
X/*    of the software without specific, written prior permission.    */
X/*    Chuck Musciano and Harris Corporation make no representations    */
X/*    about the suitability of this software for any purpose.  It is    */
X/*    provided "as is" without express or implied warranty.        */
X/*                                    */
X/*    The sale of any product based wholely or in part upon the     */
X/*    technology provided by tooltool is strictly forbidden without    */
X/*    specific, prior written permission from Harris Corporation.    */
X/*    Tooltool technology includes, but is not limited to, the source    */
X/*    code, executable binary files, specification language, and    */
X/*    sample specification files.                    */
X/************************************************************************/
X
X#define        RETURN(x)        return(last_token = (x))
X
X#define        FIRST_KEYWORD        ACTION
X#define        LAST_KEYWORD        WIDTH
X#define        NUM_KEYWORDS        (LAST_KEYWORD - FIRST_KEYWORD + 1)
X
X#define        CPP            "/lib/cpp"
X
XPRIVATE    FILE    *f;
XPRIVATE    int    last_token = -1;
XPRIVATE    char    buf[1024];
X
XPRIVATE    struct    {char    *name;
X         int    value;
X        } token[] = {{"action",        ACTION},
X                 {"align",        ALIGN},
X                 {"application",    APPLICATION},
X                 {"at",        AT},
X                 {"base",        BASE},
X                 {"beep",        BEEP},
X                 {"bottom",        BOTTOM},
X                 {"break",        BREAK},
X                 {"button",        BUTTON},
X                 {"by",        BY},
X                 {"center",        CENTER},
X                 {"characters",    CHARACTERS},
X                 {"choice",        CHOICE},
X                 {"close",        CLOSE},
X                 {"completion",    COMPLETION},
X                 {"continue",    CONTINUE},
X                 {"control",    CONTROL},
X                 {"current",    CURRENT},
X                 {"cycle",        CYCLE},
X                 {"dialog",        DIALOG},
X                 {"disable",    DISABLE},
X                 {"display",    DISPLAY},
X                 {"else",        ELSE},
X                 {"end_button",    END_BUTTON},
X                 {"end_choice",    END_CHOICE},
X                 {"end_dialog",    END_DIALOG},
X                 {"end_gadgets",    END_GADGETS},
X                 {"end_key",    END_KEY},
X                 {"end_keys",    END_KEYS},
X                 {"end_label",    END_LABEL},
X                 {"end_menu",    END_MENU},
X                 {"end_mouse",    END_MOUSE},
X                 {"end_slider",    END_SLIDER},
X                 {"end_text",    END_TEXT},
X                 {"exit",        EXIT},
X                 {"font",        FONT},
X                 {"for",        FOR},
X                 {"function_keys",    FUNCTION_KEYS},
X                 {"gadgets",    GADGETS},
X                 {"horizontal",    HORIZONTAL},
X                 {"icon",        ICON},
X                 {"if",        IF},
X                 {"ignore",        IGNORE},
X                 {"initial",    INITIAL},
X                 {"initialize",    INITIALIZE},
X                 {"key",        KEY},
X                 {"keys",        KEYS},
X                 {"label",        LABEL},
X                 {"left",        LEFT},
X                 {"mark",        MARK},
X                 {"maximum",    MAXIMUM},
X                 {"menu",        MENU},
X                 {"meta",        META},
X                 {"middle",        MIDDLE},
X                 {"minimum",    MINIMUM},
X                 {"mouse",        MOUSE},
X                 {"nomark",        NOMARK},
X                 {"normal",        NORMAL},
X                 {"normal_keys",    NORMAL_KEYS},
X                 {"nothing",    NOTHING},
X                 {"off",        OFF},
X                 {"on",        ON},
X                 {"open",        OPEN},
X                 {"pixels",        PIXELS},
X                 {"popup",        POPUP},
X                 {"proportional",    PROPORTIONAL},
X                 {"ragged",        RAGGED},
X                 {"range",        RANGE},
X                 {"remove",        REMOVE},
X                 {"retain",        RETAIN},
X                 {"right",        RIGHT},
X                 {"send",        SEND},
X                 {"shift",        SHIFT},
X                 {"size",        SIZE},
X                 {"slider",        SLIDER},
X                 {"text",        TEXT},
X                 {"timer",        TIMER},
X                 {"top",        TOP},
X                 {"trigger",    TRIGGER},
X                 {"ttymenu",    TTYMENU},
X                 {"value",        VALUE},
X                 {"vertical",    VERTICAL},
X                 {"while",        WHILE},
X                 {"width",        WIDTH}};
X
XPRIVATE    struct    {char    first;
X         char    next;
X         int    name;
X        } punc[] = {{'&',  '\0', LOGICAL_AND},
X                {'&',  '&',  AND},
X                {'&',  '=',  ASSIGN_AND},
X                {':',  '\0', COLON},
X                {',',  '\0', COMMA},
X                {'~',  '\0', COMPLEMENT},
X                {'=',  '\0', ASSIGNMENT},
X                {'=',  '=',  EQUAL},
X                {'>',  '\0', GREATER},
X                {'>',  '=',  GREATER_EQUAL},
X                {'>',  '>',  RIGHT_SHIFT},
X                {'{',  '\0', LBRACE},
X                {'[',  '\0', LBRACK},
X                {'<',  '\0', LESS},
X                {'<',  '=',  LESS_EQUAL},
X                {'<',  '<',  LEFT_SHIFT},
X                {'!',  '\0', LOGICAL_NOT},
X                {'!',  '=',  NOT_EQUAL},
X                {'|',  '\0', OR},
X                {'|',  '|',  LOGICAL_OR},
X                {'|',  '=',  ASSIGN_OR},
X                {'(',  '\0', LPAREN},
X                {'-',  '\0', MINUS},
X                {'-',  '-',  DECREMENT},
X                {'-',  '=',  ASSIGN_MINUS},
X                {'%',  '\0', MODULO},
X                {'%',  '=',  ASSIGN_MODULO},
X                {'+',  '\0', PLUS},
X                {'+',  '+',  INCREMENT},
X                {'+',  '=',  ASSIGN_PLUS},
X                {'?',  '\0', QUESTION},
X                {'}',  '\0', RBRACE},
X                {']',  '\0', RBRACK},
X                {')',  '\0', RPAREN},
X                {';',  '\0', SEMICOLON},
X                {'*',  '\0', TIMES},
X                {'*',  '=',  ASSIGN_TIMES},
X                {'^',  '\0', XOR},
X                {'^',  '=',  ASSIGN_XOR},
X                {'\0', '\0', -1}};
X
XPRIVATE    char    getch()
X
X{    register    char    c;
X    static        int    first = TRUE;
X
X    if (first) {
X       first = FALSE;
X       if ((f = popen(CPP, "r")) == NULL)
X          abend("could not invoke %s", CPP);
X       }
X    if (ungetc != -1)
X       c = ungetc, ungetc = -1;
X    else {
X       c = getc(f);
X       if (c == '\n')
X          line_count++;
X       }
X    return(c);
X}
X
XPRIVATE    fix_escapes(buf)
X
Xchar    *buf;
X
X{    char    *q;
X    int    i;
X
X    for (q = buf; *buf; buf++, q++)
X       if (*buf == '\\')
X          switch (*++buf) {
X             case 'b' : *q = '\010'; /* ^h */
X                        break;
X             case 'e' : *q = '\033'; /* esc */
X                      break;
X             case 'f' : *q = '\014'; /* ^l */
X                        break;
X             case 'n' : *q = '\012'; /* ^j */
X                        break;
X             case 'r' : *q = '\015'; /* ^m */
X                        break;
X             case 't' : *q = '\011'; /* ^i */
X                        break;
X             case '0' :
X             case '1' :
X             case '2' :
X             case '3' :
X             case '4' :
X             case '5' :
X             case '6' :
X             case '7' : *q = *buf++ - '0';
X                        for (i = 0; i < 2 && *buf >= '0' && *buf <= '7'; i++)
X                           *q = (*q << 3) + *buf++ - '0';
X                        buf--;
X                        break;
X             default  : *q = *buf;
X                        break;
X             }
X       else if (*buf == '^' && *(buf + 1) >= '@' && *(buf + 1) <= '_')
X          *q = *++buf & 0x1f;
X       else
X          *q = *buf;
X    *q = '\0';
X}
X
XPRIVATE    int    is_keyword(s)
X
Xchar    *s;
X
X{    register    int    cmp, high, low, pos;
X
X    for (low = 0, high = NUM_KEYWORDS - 1; low <= high; )
X       if ((cmp = strcmp(s, token[pos = (high - low) / 2 + low].name)) == 0)
X          return(token[pos].value);
X       else if (cmp < 0)
X          high = pos - 1;
X       else
X          low = pos + 1;
X    return(NULL);
X}
X
XPRIVATE    int    yylex()
X
X{    register    char    c, c1, *p;
X    register    int    i, j, val;
X    char            *index();
X    double            atof();
X
X    c = getch();
X    while (isspace(c))
X       c = getch();
X    if (isalpha(c)) {
X       p = buf;
X       *p++ = c;
X       while (isalnum(c = getch()) || c == '_')
X          *p++ = c;
X       ungetc = c;
X       *p = '\0';
X       for (p = buf; *p; p++)
X          if (isupper(*p))
X             *p = tolower(*p);
X       if (i = is_keyword(buf))
X          RETURN(i);
X       if ((i = strlen(buf)) == 2) { /* possible two character function key name */
X          if (buf[0] == 'l' && buf[1] >= '2' && buf[1] <= '9') /* l2 - l9 */
X             RETURN(yylval.ival = L2 + buf[1] - '2');
X          else if (buf[0] == 'f' && buf[1] >= '1' && buf[1] <= '9') /* f1 - f9 */
X             RETURN(yylval.ival = F1 + buf[1] - '1');
X          else if (buf[0] == 'r' && buf[1] >= '1' && buf[1] <= '9') /* r1 - r9 */
X             RETURN(yylval.ival = R1 + buf[1] - '1');
X          }
X       else if (i == 3) { /* possible three character function key name */
X          if (buf[0] == 'l' && buf[1] == '1' && buf[2] == '0')
X             RETURN(yylval.ival = L10);
X          else if (buf[0] == 'r' && buf[1] == '1' && buf[2] >= '0' && buf[2] <= '5') /* r10 - r15 */
X             RETURN(yylval.ival = R10 + buf[2] - '0');
X          }
X       fix_escapes(buf);
X       yylval.cpval = strsave(buf);
X       RETURN(ID);
X       }
X    else if (c == '"') {
X       for (p = buf; TRUE; p++)
X          if ((*p = getch()) == '"')
X             break;
X          else if (*p == '\\')
X             *++p = getch();
X          else if (*p == '\n' || *p == '\r') {
X             yyerror("Newline in string not allowed");
X             break;
X             }
X       *p = '\0';
X       fix_escapes(buf);
X       yylval.cpval = strsave(buf);
X       RETURN(STRING);
X       }
X    else if (c == '\'') {
X       p = buf;
X       for (p = buf; TRUE; p++)
X          if ((*p = getch()) == '\'')
X             break;
X          else if (*p == '\\')
X             *++p = getch();
X          else if (*p == '\n' || *p == '\r') {
X             yyerror("Newline in string not allowed");
X             break;
X             }
X       *p = '\0';
X       fix_escapes(buf);
X       yylval.cpval = strsave(buf);
X       RETURN(ICON_STRING);
X       }
X    else if (isdigit(c)) {
X       if (c == '0') {
X          if ((c = getch()) == 'x') /* hex number */
X             for (val = 0; isxdigit(c = getch()); )
X                if (isdigit(c))
X                   val = val * 16 + c - '0';
X                else
X                   val = val * 16 + c - (isupper(c)? 'A' : 'a');
X          else if (isdigit(c)) /* octal */
X             for (val = c - '0'; (c = getch()) >= '0' && c <= '7'; )
X                val = val * 8 + c - '0';
X          else if (c == '.') {
X             ungetc = c;
X             c = '0';
X             goto do_real; /* with God as my witness, I'll never do this again, I swear */
X             }
X          else
X             val = 0;
X          ungetc = c;
X          yylval.ival = val;
X          RETURN(INTEGER);
X          }
X       else {
Xdo_real:      p = buf;
X          *p++ = c;
X          val = INTEGER;
X          while (isdigit(c = getch()))
X             *p++ = c;
X          if (c == '.')
X             for (*p++ = c, val = REAL; isdigit(c = getch()); )
X                *p++ = c;
X          if (c == 'e' || c == 'E') {
X             *p++ = c;
X             if ((c = getch()) == '-' || c == '+')
X                *p++ = c;
X             else
X                ungetc = c;
X             for (val = REAL; isdigit(c = getch()); )
X                *p++ = c;
X             }
X          *p = '\0';
X          ungetc = c;
X          if (val == INTEGER)
X             yylval.ival = atoi(buf);
X          else
X             yylval.rval = atof(buf);
X          RETURN(val);
X          }
X       }
X    else if (c == '/') {
X       if ((c = getch()) == '*') {
X          while (1) {
X             while ((c = getch()) != '*')
X                ;
X             if ((c = getch()) == '/')
X                break;
X             }
X          }
X       else if (c == '=')
X          RETURN(ASSIGN_DIVIDE);
X       else {
X          ungetc = c;
X          RETURN(DIVIDE);
X          }
X       }
X    else if (c == '#') {
X       if (yylex() == INTEGER) {
X          line_count = yylval.ival - 1; /* getch will bump by 1 when \n is read */
X          if (yylex() == STRING) {
X             if (*yylval.cpval)
X                tt_curr_file = yylval.cpval;
X             while (getch() != '\n')
X                ;
X             RETURN(yylex());
X             }
X          }
X       yyerror("Invalid cpp control sequence in source file");
X       }
X    else if (c == EOF) {
X       pclose(f);
X       RETURN(EOF);
X       }
X    else {
X       for (i = 0; punc[i].first; i++)
X          if (c == punc[i].first) {
X             for (c1 = getch(), j = 1; punc[i + j].first == c; j++)
X                if (c1 == punc[i + j].next)
X                   RETURN(punc[i + j].name);
X             ungetc = c1;
X             RETURN(punc[i].name);
X             }
X       yyerror("Invalid character in source file: %c (0x%02x)", c, c);
X       }
X    RETURN(yylex());
X}
X
X/************************************************************************/
XPRIVATE    print_last_token()
X
X{    int    i;
X
X    fprintf(stderr, " at or near \"");
X    if (last_token == INTEGER || last_token == REAL || last_token == STRING || last_token == ICON_STRING || last_token == ID)
X       fprintf(stderr, buf);
X    else if (last_token >= L2 && last_token <= L10)
X       fprintf(stderr, "L%d", last_token - L2 + 2);
X    else if (last_token >= F1 && last_token <= F9)
X       fprintf(stderr, "F%d", last_token - F1 + 1);
X    else if (last_token >= R1 && last_token <= R15)
X       fprintf(stderr, "R%d", last_token - R1 + 1);
X    else if (last_token >= AND && last_token <= XOR) {
X       for (i = 0; punc[i].first; i++)
X          if (punc[i].name == last_token) {
X             fprintf(stderr, "%c", punc[i].first);
X             if (punc[i].next)
X                fprintf(stderr, "%c", punc[i].next);
X             break;
X             }
X       if (punc[i].first == '\0')
X          fprintf(stderr, "!!Geez!  Some punctuation, I don't know!!");
X       }
X    else if (last_token >= FIRST_KEYWORD && last_token <= LAST_KEYWORD)
X       fprintf(stderr, token[last_token - FIRST_KEYWORD].name);
X    else if (last_token == EOF)
X       fprintf(stderr, "End Of File");
X    else
X       fprintf(stderr, "!!Geez!  Some keyword, I don't know!!");
X    fprintf(stderr, "\"");
X}
END_OF_FILE
if test 13060 -ne `wc -c <'lex.c'`; then
    echo shar: \"'lex.c'\" unpacked with wrong size!
fi
# end of 'lex.c'
fi
echo shar: End of archive 5 \(of 13\).
cp /dev/null ark5isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 13 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0

Chuck Musciano            ARPA  : [e-mail]
Harris Corporation         Usenet: ...!uunet!x102a!trantor!chuck
PO Box 37, MS 3A/1912        AT&T  : [phone]
Melbourne, FL 32902        FAX   : (407) 727-{5118,5227,4004}